home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / rcdsplay.zip / IOFUNCS.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-18  |  25KB  |  632 lines
  1. {**********************************************************************
  2.  Unit   : IOFUNCS
  3.  Version: 1.8
  4.  Purpose: This unit contains useful procedures to simplify IO tasks.
  5.  Author : Translated form those of Mike Riebe (MISFUNCS, version 3.3)
  6.           by Roger Carlson.
  7.  Changes: 5/17/90 (RJC,1.1) - Added the procedures of version 1.7 of
  8.             RCGRAF.
  9.           5/31/90 (RJC,1,2) - Removed the RLTOSTR, DBLTOSTR, LNGTOSTR,
  10.             and INTTOSTR procedures which are more easily implemented
  11.             by Turbo Pascal's STR procedure.
  12.           6/9/90 (RJC,1.3) - Added graphics mode rdstr procedures and
  13.             INTTOSTR.
  14.           2/15/91 (RJC,1.4) - Added line feed at end of some procedures.
  15.           3/28/91 (RJC,1.5) - Added RLTOSTR funciton and the graphics
  16.             mode GRDINT procedure.
  17.           5/3/91 (RJC,1.6) - Added graphics mode GRDDBL and GRDREAL
  18.             procedures.
  19.           5/11/91 (RJC,1.7) - Added the DOS shell command DOS_CMD.
  20.           5/18/91 (RJC,1.8) - Added LNGTOSTR function and RDLONGLN
  21.             procedure.
  22. ***********************************************************************}
  23. UNIT IOFUNCS;
  24.  
  25. INTERFACE
  26.  
  27. TYPE STR160 = STRING[160];  STR80  = STRING[80];  STR40  = STRING[40];
  28.      STR30  = STRING[30];   STR20  = STRING[20];  STR3   = STRING[3];
  29.  
  30. PROCEDURE rdrealn(VAR window : TEXT; VAR value : REAL);
  31. PROCEDURE rddbln(VAR window : TEXT; VAR value : DOUBLE);
  32. PROCEDURE rdintln(VAR window : TEXT; VAR value : INTEGER);
  33. PROCEDURE RDLONGLN(VAR WINDOW:TEXT; VAR VALUE:LONGINT);
  34. PROCEDURE rdstr160(VAR window : TEXT; VAR value : STR160);
  35. PROCEDURE rdstr80(VAR WINDOW:TEXT; VAR value:STR80);
  36. PROCEDURE rdstr40(VAR WINDOW:TEXT; VAR value:STR40);
  37. PROCEDURE rdstr30(VAR WINDOW:TEXT; VAR value:STR30);
  38. PROCEDURE rdstr20(VAR window : TEXT; VAR value : STR20);
  39. PROCEDURE rdstr3(VAR window : TEXT; VAR value : STR3);
  40. PROCEDURE rdcharln(VAR window : TEXT; VAR value : CHAR);
  41. PROCEDURE GRDSTR160(VAR VALUE:STR160);
  42. PROCEDURE GRDSTR80(VAR VALUE:STR80);
  43. PROCEDURE GRDSTR40(VAR VALUE:STR40);
  44. PROCEDURE GRDSTR30(VAR VALUE:STR30);
  45. PROCEDURE GRDSTR20(VAR VALUE:STR20);
  46. PROCEDURE GRDSTR3(VAR VALUE:STR3);
  47. PROCEDURE GRDCHAR(VAR VALUE:CHAR);
  48. PROCEDURE GRDINT(VAR VALUE:INTEGER);
  49. PROCEDURE GRDDBL(VAR VALUE:DOUBLE);
  50. PROCEDURE GRDREAL(VAR VALUE:REAL);
  51. FUNCTION CALCINCR(INCR:DOUBLE):DOUBLE;
  52.     {This function returns the largest power of 1, 2, or 5 <= INCR and can be
  53.      used to calculate round number intervals for labeling of plots.  INCR
  54.      should be a positive number.}
  55. PROCEDURE ENGNOT(NUMBER:DOUBLE; VAR MANTISSA:DOUBLE; VAR EXPONENT:LONGINT);
  56.     {This procedure calculates the engineering notation mantissa and exponent
  57.      for the number NUMBER.}
  58. FUNCTION NUMDEC(NUM:DOUBLE):INTEGER;
  59.     {Calculates the number of decimals in a number to an accuracy of about 1
  60.      part in 1E6}
  61. FUNCTION EXISTS(FILENAME:STR30):BOOLEAN;
  62. PROCEDURE BEEP(HZ:WORD);
  63. FUNCTION INTTOSTR(I:INTEGER):STR80; {Converts an integer to a string.}
  64. FUNCTION LNGTOSTR(I:LONGINT):STR80; {Converts a long integer to a string.}
  65. FUNCTION RLTOSTR(RL:REAL;WIDTH:INTEGER):STR80;
  66.   {Converts a real number to a string.}
  67. PROCEDURE DOS_CMD; {executes a dos command}
  68.  
  69.  
  70. IMPLEMENTATION
  71.  
  72. USES CRT, GRAPH, DOS, MATH;
  73.  
  74. {************************ PROCEDURE DOS_CMD **************************}
  75. PROCEDURE DOS_CMD;
  76. VAR NAME:STR80;
  77. BEGIN
  78.   CLRSCR;
  79.   WRITE('Command: '); RDSTR80(OUTPUT,NAME); WRITELN;
  80.   SWAPVECTORS; EXEC('C:\COMMAND.COM',CONCAT('/C ',NAME)); SWAPVECTORS;
  81.   IF DOSERROR<>0 THEN WRITELN('DOS ERROR # ',DOSERROR);
  82.   WRITE('Hit <ENTER> to continue.'); READLN;
  83. END;
  84.  
  85. {******************************************************************************
  86.   TITLE:    RDREALN(VAR WINDOW:TEXT; VAR VALUE : REAL);
  87.   FUNCTION: To provide a mechanism for reading real numbers from the keyboard
  88.             as well as provide for keeping the current value of the variable
  89.             to be read by inputing a carriage return.
  90.   INPUTS:   A string of digits including '+','-','.',and 'E' defining a real
  91.             value.
  92.   OUTPUTS:  A new value for a variable unless <CR> was the only character
  93.             in the input string.
  94.   AUTHOR:   M. Riebe  11/17/84
  95.   CHANGES:  12/06/84:  Fixed procedure for finding starting index so that only
  96.                        digits are valid.
  97.             5/15/85 MTR: Fixed correction procedure to allow backspaces.
  98.             6/20/85 RJC: Improved error correction.
  99.             10/1/85 MTR: Changed to use RDDBLN and convert to real.
  100.             10/30/85 RJC:Fixed so that value unchanged if return is entered.
  101.             4/8/90   RJC:Translated to Turbo Pascal.
  102. ******************************************************************************}
  103. PROCEDURE RDREALN;
  104. VAR DBLTEMP:DOUBLE;
  105. BEGIN DBLTEMP:=VALUE; RDDBLN(WINDOW,DBLTEMP); VALUE:=DBLTEMP; END;
  106.  
  107. {******************************************************************************
  108.   TITLE:    RDDBLN(VAR WINDOW:TEXT; VAR VALUE:DOUBLE)
  109.   VERSION:  1.1
  110.   FUNCTION: Input of double precision real numbers interactively from the
  111.             keyboard.
  112.   AUTHOR:   RJC 9/29/85
  113.   CHANGES:  (4/8/90, 1.1, RJC) - Translated to Turbo Pascal.  Modified to
  114.                prevent reading of spurious characters and backspacing before
  115.                the first character.
  116. ******************************************************************************}
  117. PROCEDURE RDDBLN;
  118. VAR
  119.   CH                 : CHAR;
  120.   I,J,K,L,M,N,POWVAL : INTEGER;
  121.   ASCII              : ARRAY[1..20] OF INTEGER;
  122.   NEG,POWNEG         : BOOLEAN;
  123. BEGIN {1}
  124.   NEG := FALSE;  POWNEG := FALSE;  POWVAL := 0;  I := 1;
  125.   REPEAT
  126.     REPEAT CH:=READKEY
  127.     UNTIL CH IN ['0'..'9','+','-','D','E','.',CHR(13),CHR(8)];
  128.     ASCII[I]:=ORD(CH);
  129.     IF (ASCII[I] = 8) THEN BEGIN
  130.       IF I<>1 THEN WRITE(WINDOW,CH,' ',CH);
  131.       IF I<=2 THEN I:=0 ELSE I:=I-2;
  132.       END
  133.     ELSE WRITE(WINDOW,CH);
  134.     I:=I+1;
  135.   UNTIL ORD(CH)=13;
  136.   I:=I-1;                   {leave index at last character}
  137.   IF ASCII[1]<>13 THEN BEGIN {2}
  138.       VALUE:=0; J:=0; K:=0;
  139.       REPEAT J:=J+1 UNTIL ASCII[J] IN [43,45..58];
  140.       REPEAT K:=K+1 UNTIL ASCII[K] IN [46,68,69,13];
  141.       CASE ASCII[J] OF
  142.          43 {+}: J:=J+1;
  143.          45 {-}: BEGIN NEG:=TRUE; J:=J+1; END;
  144.       END; {CASE}
  145.       FOR L:=J TO (K-1) DO VALUE:=VALUE+(ASCII[L]-48)*PWROF10(K-L-1);
  146.       IF ASCII[K]=46 THEN BEGIN {'.'}
  147.         M := K;
  148.         REPEAT M:= M + 1 UNTIL ASCII[M] IN [68,69,13];
  149.         FOR N:=K+1 TO M-1 DO VALUE:=VALUE+(ASCII[N]-48)/PWROF10(N-K);
  150.         K := M;
  151.         END; {IF}
  152.       IF ASCII[K] IN [68,69] THEN BEGIN {'D' or 'E'}
  153.         CASE ASCII[K+1] OF
  154.           43 {+}: K:=K+1;
  155.           45 {-}: BEGIN POWNEG:=TRUE; K:=K+1; END;
  156.         END; {CASE}
  157.         FOR N:=K+1 TO I-1 DO POWVAL:=POWVAL+
  158.                              (ASCII[N]-48)*ROUND(PWROF10(I-N-1));
  159.         END; {IF}
  160.       IF NEG THEN VALUE:=VALUE*(-1);
  161.       IF POWNEG THEN VALUE := VALUE/PWROF10(POWVAL)
  162.       ELSE VALUE := VALUE*PWROF10(POWVAL);
  163.     END;  {2}
  164.   WRITE(WINDOW,CHR($0A)); {line feed}
  165.   END; {1}
  166.  
  167. {******************************************************************************
  168.   TITLE:     rdintln(VAR WINDOW:TEXT; VAR VALUE:INTEGER);
  169.   FUNCTION:  To provide a mechanism for reading integers from the keyboard
  170.              while providing for keeping the current value of the variable
  171.              if a carriage return is input.
  172.   INPUTS:    A string of digits followed by a <CR> or just a <CR>.
  173.   OUTPUTS:   A new value for the variable value unless <CR> was the only
  174.              character in the input string.
  175.   NOTES:     Should someday be modified to allow input from any file type,
  176.              i.e., not just INPUT.
  177.   AUTHOR:    M. Riebe  11/17/84
  178.   CHANGES:   5/15/85 MTR: Fixed input routine to allow backspaces for
  179.                           corrections.
  180.              6/20/85 RJC: Improved error correction.
  181.              5/8/90  RJC: Translated to Turbo Pascal.  Added same changes
  182.                as versions 1.1 of RDDBLN.
  183.              5/18/91 RJC: Corrected number of digits error to allow up to
  184.                6 digits.
  185. ******************************************************************************}
  186. PROCEDURE rdintln;
  187. VAR
  188.   CH        : CHAR;
  189.   ascii     : array[1..10] of INTEGER;
  190.   I,J,START : INTEGER;
  191.   NEG       : BOOLEAN;
  192. BEGIN
  193.   NEG:=FALSE; START:=0; I:=1;
  194.   REPEAT
  195.     IF I>=7 THEN REPEAT CH:=READKEY UNTIL CH IN [CHR(13),CHR(8)]
  196.     ELSE REPEAT CH:=READKEY UNTIL CH IN ['0'..'9','+','-',CHR(13),CHR(8)];
  197.     ASCII[I]:=ORD(CH);
  198.     IF (ASCII[I] = 8) THEN BEGIN
  199.       IF I<>1 THEN WRITE(WINDOW,CH,' ',CH);
  200.       IF I<=2 THEN I:=0 ELSE I:=I-2;
  201.       END
  202.     ELSE WRITE(WINDOW,CH);
  203.     I:=I+1;
  204.   UNTIL ORD(CH)=13;
  205.   I:=I-1;                    {leave index at last character}
  206.   IF ascii[1] <> 13 THEN BEGIN
  207.     REPEAT START:=START+1 UNTIL ASCII[START] IN [48..57];
  208.     IF ASCII[1]=45 THEN NEG:=TRUE;
  209.     value := 0;
  210.     FOR j:=START to I-1 DO value:=value+(ascii[J]-48)*ROUND(PWROF10(I-J-1));
  211.     IF NEG THEN VALUE:=-VALUE;
  212.     END;
  213.   WRITE(WINDOW,CHR($0A)); {line feed}
  214. END;
  215.  
  216. {******************************************************************************
  217.   TITLE:     RDLONGLN(VAR WINDOW:TEXT; VAR VALUE:LONGINT);
  218.   FUNCTION:  To provide a mechanism for reading long integers from the
  219.              keyboard while providing for keeping the current value of
  220.              the variable if a carriage return is input.
  221.   INPUTS:    A string of digits followed by a <CR> or just a <CR>.
  222.   OUTPUTS:   A new value for the variable value unless <CR> was the only
  223.              character in the input string.
  224.   AUTHOR:    R. Carlson 5/18/91
  225.   CHANGES:
  226. ******************************************************************************}
  227. PROCEDURE RDLONGLN;
  228. VAR
  229.   CH        : CHAR;
  230.   ascii     : array[1..13] of INTEGER;
  231.   I,J,START : INTEGER;
  232.   NEG       : BOOLEAN;
  233. BEGIN
  234.   NEG:=FALSE; START:=0; I:=1;
  235.   REPEAT
  236.     IF I>=12 THEN
  237.        REPEAT CH:=READKEY UNTIL CH IN [CHR(13),CHR(8)]
  238.     ELSE REPEAT CH:=READKEY UNTIL CH IN ['0'..'9','+','-',CHR(13),CHR(8)];
  239.     ASCII[I]:=ORD(CH);
  240.     IF (ASCII[I] = 8) THEN BEGIN
  241.       IF I<>1 THEN WRITE(WINDOW,CH,' ',CH);
  242.       IF I<=2 THEN I:=0 ELSE I:=I-2;
  243.       END
  244.     ELSE WRITE(WINDOW,CH);
  245.     I:=I+1;
  246.   UNTIL ORD(CH)=13;
  247.   I:=I-1;                    {leave index at last character}
  248.   IF ascii[1] <> 13 THEN BEGIN
  249.     REPEAT START:=START+1 UNTIL ASCII[START] IN [48..57];
  250.     IF ASCII[1]=45 THEN NEG:=TRUE;
  251.     value := 0;
  252.     FOR j:=START to I-1 DO value:=value+(ascii[J]-48)*ROUND(PWROF10(I-J-1));
  253.     IF NEG THEN VALUE:=-VALUE;
  254.     END;
  255.   WRITE(WINDOW,CHR($0A)); {line feed}
  256. END;
  257.  
  258. PROCEDURE RDSTR(VAR WINDOW:TEXT; VAR VALUE:STR160; MAX:INTEGER);
  259. {******************************************************************************
  260.   FUNCTION:  To read a string input and if the input is not <CR>, assign it
  261.              to the variable.
  262.   INPUTS:    A string of length MAX up to 160 characters.
  263.   OUTPUTS:   The input string if it was not simply a <CR>.
  264.   AUTHOR:    Adapted by Roger Carlson from rdstr160 of M. Riebe.
  265. ******************************************************************************}
  266. VAR INSTRING:STR160; C:STRING[1]; CH:CHAR;
  267. BEGIN
  268.   INSTRING:='';
  269.   REPEAT
  270.     IF LENGTH(INSTRING)>=MAX THEN
  271.       REPEAT CH:=READKEY UNTIL CH IN [CHR(8),CHR(13)]
  272.     ELSE REPEAT CH:=READKEY UNTIL CH<>#0;
  273.     IF NOT ((LENGTH(INSTRING)=0) AND (CH=CHR(8))) THEN
  274.       IF CH=CHR(8) THEN WRITE(WINDOW,CH,' ',CH) ELSE WRITE(WINDOW,CH);
  275.     C[0]:=CHR(1); C[1]:=CH;
  276.     IF ORD(CH)=8 THEN DELETE(INSTRING,LENGTH(INSTRING),1)
  277.     ELSE IF ORD(CH)<>13 THEN INSTRING:=CONCAT(INSTRING,C);
  278.   UNTIL ORD(CH)=13;
  279.   WRITE(WINDOW,CHR($0A)); {line feed}
  280.   IF INSTRING<>'' THEN VALUE:=INSTRING;
  281. END;
  282.  
  283. PROCEDURE GRDSTR(VAR VALUE:STR160; MAX:INTEGER);
  284. {******************************************************************************
  285.   FUNCTION:  To read a string input with echoing to the graphics screen.
  286.              If the string is unchanged if a carriage return is entered.
  287.   INPUTS:    A string of length MAX up to 160 characters.
  288.   OUTPUTS:   The input string if it was not simply a <CR>.
  289.   AUTHOR:    Adapted by Roger Carlson from rdstr160 of M. Riebe.
  290. ******************************************************************************}
  291. VAR INSTRING :STR160; C:STRING[1]; CH:CHAR;
  292.     SETTINGS : TEXTSETTINGSTYPE;
  293.     DX,X,Y   : INTEGER;
  294.     VIEWPORT : VIEWPORTTYPE;
  295. BEGIN
  296.   GETTEXTSETTINGS(SETTINGS);
  297.   GETVIEWSETTINGS(VIEWPORT); {save the current viewport settings}
  298.   DX:=SETTINGS.CHARSIZE*8;
  299.   INSTRING:='';
  300.   REPEAT
  301.     IF LENGTH(INSTRING)>=MAX THEN
  302.       REPEAT CH:=READKEY UNTIL CH IN [CHR(8),CHR(13)]
  303.     ELSE REPEAT CH:=READKEY UNTIL CH<>#0;
  304.     IF NOT ((LENGTH(INSTRING)=0) AND (CH=CHR(8))) THEN
  305.       IF CH=CHR(8) THEN BEGIN
  306.         MOVEREL(-DX,0); X:=GETX; Y:=GETY;
  307.         SETVIEWPORT(X,Y,X+8,Y+8,CLIPON); CLEARVIEWPORT;
  308.         SETVIEWPORT(VIEWPORT.X1,VIEWPORT.Y1,VIEWPORT.X2,VIEWPORT.Y2,CLIPON);
  309.         MOVETO(X,Y);
  310.         END {IF}
  311.       ELSE IF CH<>CHR(13) THEN OUTTEXT(CH);
  312.     C[0]:=CHR(1); C[1]:=CH;
  313.     IF ORD(CH)=8 THEN DELETE(INSTRING,LENGTH(INSTRING),1)
  314.     ELSE IF ORD(CH)<>13 THEN INSTRING:=CONCAT(INSTRING,C);
  315.   UNTIL ORD(CH)=13;
  316.   IF INSTRING<>'' THEN VALUE:=INSTRING;
  317. END;
  318.  
  319. {******************************************************************************
  320.   TITLE:     grdint(VAR VALUE:INTEGER);
  321.   FUNCTION:  To provide a mechanism for reading integers from a graphics
  322.              screen.
  323.   INPUTS:    A string of digits followed by a <CR> or just a <CR>.
  324.   OUTPUTS:   A new value for the variable value unless <CR> was the only
  325.              character in the input string.
  326.   AUTHOR:    R. Carlson   3/28/91
  327.   CHANGES:
  328. ******************************************************************************}
  329. PROCEDURE grdint;
  330. VAR
  331.   SETTINGS  : TEXTSETTINGSTYPE;
  332.   DX,X,Y    : INTEGER;
  333.   VIEWPORT  : VIEWPORTTYPE;
  334.   CH        : CHAR;
  335.   ascii     : array[1..10] of INTEGER;
  336.   I,J,START : INTEGER;
  337.   NEG       : BOOLEAN;
  338. BEGIN
  339.   GETTEXTSETTINGS(SETTINGS);
  340.   GETVIEWSETTINGS(VIEWPORT); {save the current viewport settings}
  341.   DX:=SETTINGS.CHARSIZE*8;
  342.   NEG:=FALSE; START:=0; I:=1;
  343.   REPEAT
  344.     IF I>=6 THEN REPEAT CH:=READKEY UNTIL CH IN [CHR(13),CHR(8)]
  345.     ELSE REPEAT CH:=READKEY UNTIL CH IN ['0'..'9','+','-',CHR(13),CHR(8)];
  346.     ASCII[I]:=ORD(CH);
  347.     IF NOT ((I=1) AND (CH=CHR(8))) THEN BEGIN
  348.       IF CH=CHR(8) THEN BEGIN
  349.         IF I<>1 THEN BEGIN
  350.           MOVEREL(-DX,0); X:=GETX; Y:=GETY;
  351.           SETVIEWPORT(X,Y,X+8,Y+8,CLIPON); CLEARVIEWPORT;
  352.           SETVIEWPORT(VIEWPORT.X1,VIEWPORT.Y1,VIEWPORT.X2,VIEWPORT.Y2,CLIPON);
  353.           MOVETO(X,Y);
  354.           END; {IF I<>1}
  355.         IF I<=2 THEN I:=0 ELSE I:=I-2;
  356.         END {IF CH=CHR(8)}
  357.       ELSE IF CH<>CHR(13) THEN OUTTEXT(CH);
  358.       I:=I+1;
  359.       END; {IF}
  360.   UNTIL ORD(CH)=13;
  361.   I:=I-1;                    {leave index at last character}
  362.   IF ascii[1] <> 13 THEN BEGIN
  363.     REPEAT START:=START+1 UNTIL ASCII[START] IN [48..57];
  364.     IF ASCII[1]=45 THEN NEG:=TRUE;
  365.     value := 0;
  366.     FOR j:=START to I-1 DO value:=value+(ascii[J]-48)*ROUND(PWROF10(I-J-1));
  367.     IF NEG THEN VALUE:=-VALUE;
  368.     END;
  369. END;
  370.  
  371. {******************************************************************************
  372.   TITLE:     grddbl(VAR VALUE:DOUBLE);
  373.   FUNCTION:  To provide a mechanism for reading double precision numbers
  374.              from a graphics screen.
  375.   INPUTS:    A string of digits followed by a <CR> or just a <CR>.
  376.   OUTPUTS:   A new value for the variable value unless <CR> was the only
  377.              character in the input string.
  378.   AUTHOR:    R. Carlson   5/3/91
  379.   CHANGES:
  380. ******************************************************************************}
  381. PROCEDURE grddbl;
  382. VAR
  383.   SETTINGS  : TEXTSETTINGSTYPE;
  384.   DX,X,Y    : INTEGER;
  385.   VIEWPORT  : VIEWPORTTYPE;
  386.   CH        : CHAR;
  387.   ascii     : array[1..12] of INTEGER;
  388.   I,J,N,START,START1 : INTEGER;
  389.   NEG       : BOOLEAN;
  390.   POWNEG    : BOOLEAN;
  391.   POWVAL    : INTEGER;
  392. BEGIN
  393.   GETTEXTSETTINGS(SETTINGS);
  394.   GETVIEWSETTINGS(VIEWPORT); {save the current viewport settings}
  395.   DX:=SETTINGS.CHARSIZE*8;  I:=1;
  396.   REPEAT
  397.     IF I>=12 THEN REPEAT CH:=READKEY UNTIL CH IN [CHR(13),CHR(8)];
  398.     REPEAT CH:=READKEY
  399.     UNTIL CH IN ['0'..'9','.','+','-','E','e',CHR(13),CHR(8)];
  400.     ASCII[I]:=ORD(CH);
  401.     IF NOT ((I=1) AND (CH IN [CHR(8),'.','e','E'])) THEN BEGIN
  402.       IF CH=CHR(8) THEN BEGIN
  403.         IF I<>1 THEN BEGIN
  404.           MOVEREL(-DX,0); X:=GETX; Y:=GETY;
  405.           SETVIEWPORT(X,Y,X+8,Y+8,CLIPON); CLEARVIEWPORT;
  406.           SETVIEWPORT(VIEWPORT.X1,VIEWPORT.Y1,VIEWPORT.X2,VIEWPORT.Y2,CLIPON);
  407.           MOVETO(X,Y);
  408.           END; {IF I<>1}
  409.         IF I<=2 THEN I:=0 ELSE I:=I-2;
  410.         END {IF CH=CHR(8)}
  411.       ELSE IF CH<>CHR(13) THEN OUTTEXT(CH);
  412.       I:=I+1;
  413.       END; {IF}
  414.   UNTIL ORD(CH)=13;
  415.   I:=I-1;                    {leave index at last character}
  416.   IF ascii[1] <> 13 THEN BEGIN
  417.     START:=0; START1:=0;
  418.     REPEAT START:=START+1 UNTIL ASCII[START] IN [43,45,48..57];
  419.     REPEAT START1:=START1+1 UNTIL ASCII[START1] IN [46,69,101,13];
  420.     NEG:=FALSE;
  421.     CASE ASCII[START] OF
  422.       45: BEGIN {-} NEG:=TRUE;  START:=START+1; END;
  423.       43: {+}  START:=START+1;
  424.     END; {CASE}
  425.     value := 0;
  426.     FOR J:=START TO (START1-1) DO {left of decimal}
  427.        VALUE:=VALUE+(ASCII[J]-48)*PWROF10(START1-J-1);
  428.     IF ASCII[START1]=46 THEN BEGIN {'.'}
  429.       J:=START1;
  430.       REPEAT J:=J+1 UNTIL ASCII[J] IN [69,101,13];
  431.       FOR N:=START1+1 TO J-1 DO VALUE:=VALUE+(ASCII[N]-48)/PWROF10(N-START1);
  432.       START1:=J;
  433.       END;
  434.     POWVAL:=0;
  435.     IF ASCII[START1] IN [69,101] THEN BEGIN {'E','e'}
  436.       START1:=START1+1; POWNEG:=FALSE;
  437.       CASE ASCII[START1] OF
  438.         45: BEGIN {-} POWNEG:=TRUE; START1:=START1+1; END;
  439.         43: {+} START1:=START1+1;
  440.       END; {CASE}
  441.       FOR N:=START1 TO I-1 DO POWVAL:=POWVAL
  442.                               +(ASCII[N]-48)*ROUND(PWROF10(I-N-1));
  443.       END; {IF}
  444.     IF NEG THEN VALUE:=-VALUE;
  445.     IF POWNEG THEN VALUE:=VALUE/PWROF10(POWVAL)
  446.     ELSE VALUE:=VALUE*PWROF10(POWVAL);
  447.     END;
  448. END;
  449.  
  450. {******************************************************************************
  451.   TITLE:     GRDREAL(VAR VALUE:REAL);
  452.   FUNCTION:  To provide a mechanism for reading real numbers from a graphics
  453.              screen.
  454.   INPUTS:    A string of digits followed by a <CR> or just a <CR>.
  455.   OUTPUTS:   A new value for the variable value unless <CR> was the only
  456.              character in the input string.
  457.   AUTHOR:    R. Carlson   5/3/91
  458.   CHANGES:
  459. ******************************************************************************}
  460. PROCEDURE GRDREAL;
  461. VAR DBLTEMP:DOUBLE;
  462. BEGIN DBLTEMP:=VALUE; GRDDBL(DBLTEMP); VALUE:=DBLTEMP; END;
  463.  
  464. {******************************************************************************
  465.   TITLE:     rdstrxxx(VAR WINDOW:TEXT; VAR VALUE:STRxxx);
  466.   FUNCTION:  To read a string input and if the input is not <CR>, assign it
  467.              to the variable.
  468.   INPUTS:    A string of up to 160 characters.
  469.   OUTPUTS:   The input string if it was not simply a <CR>.
  470.   AUTHOR:    M. Riebe   11/17/84
  471.   CHANGES:   12/06/84:  Fixed input/output so that it is cleaner.
  472.              9/24/85 RJC: Switched to single character reading so that input
  473.                           can be echoed to any window.
  474.              9/25/85 RJC: Modified so that all use rdstr160.
  475.                           Added rdstr80.
  476.              2/04/86 RJC: Added rdstr30 and rdstr40.
  477.                           Added truncation of strings to the correct size.
  478.              4/8/90  RJC: Translated to Turbo Pascal.  Modified to use the
  479.                           local procedure RDSTR.
  480. ******************************************************************************}
  481. PROCEDURE RDSTR160;
  482. VAR ST:STR160;
  483. BEGIN ST:=VALUE; RDSTR(WINDOW,ST,160); VALUE:=ST; END;
  484.  
  485. PROCEDURE GRDSTR160;
  486. VAR ST:STR160;
  487. BEGIN ST:=VALUE; GRDSTR(ST,160); VALUE:=ST; END;
  488.  
  489. PROCEDURE RDSTR80;
  490. VAR ST:STR160;
  491. BEGIN ST:=VALUE; RDSTR(WINDOW,ST,80); VALUE:=ST; END;
  492.  
  493. PROCEDURE GRDSTR80;
  494. VAR ST:STR160;
  495. BEGIN ST:=VALUE; GRDSTR(ST,80); VALUE:=ST; END;
  496.  
  497. PROCEDURE RDSTR40;
  498. VAR ST:STR160;
  499. BEGIN ST:=VALUE; RDSTR(WINDOW,ST,40); VALUE:=ST; END;
  500.  
  501. PROCEDURE GRDSTR40;
  502. VAR ST:STR160;
  503. BEGIN ST:=VALUE; GRDSTR(ST,40); VALUE:=ST; END;
  504.  
  505. PROCEDURE rdstr30;
  506. VAR ST:STR160;
  507. BEGIN ST:=VALUE; RDSTR(WINDOW,ST,30); VALUE:=ST; END;
  508.  
  509. PROCEDURE Grdstr30;
  510. VAR ST:STR160;
  511. BEGIN ST:=VALUE; GRDSTR(ST,30); VALUE:=ST; END;
  512.  
  513. PROCEDURE rdstr20;
  514. VAR ST :STR160;
  515. BEGIN ST:=VALUE; RDSTR(WINDOW,ST,20); VALUE:=ST; END;
  516.  
  517. PROCEDURE Grdstr20;
  518. VAR ST :STR160;
  519. BEGIN ST:=VALUE; GRDSTR(ST,20); VALUE:=ST; END;
  520.  
  521. PROCEDURE rdstr3;
  522. VAR ST : STR160;
  523. BEGIN ST:=VALUE; RDSTR(WINDOW,ST,3); VALUE:=ST; END;
  524.  
  525. PROCEDURE Grdstr3;
  526. VAR ST : STR160;
  527. BEGIN ST:=VALUE; GRDSTR(ST,3); VALUE:=ST; END;
  528.  
  529. PROCEDURE rdcharln;
  530. VAR ST:STR160;
  531. BEGIN ST:=VALUE; RDSTR(WINDOW,ST,1); VALUE:=ST[1]; END;
  532.  
  533. PROCEDURE Grdchar;
  534. VAR ST:STR160;
  535. BEGIN ST:=VALUE; GRDSTR(ST,1); VALUE:=ST[1]; END;
  536.  
  537. {******************************************************************************}
  538. {************** FUNCTION CALCINCR(INCR:DOUBLE):DOUBLE  ************************}
  539. {******************************************************************************}
  540. FUNCTION CALCINCR;
  541.   {Calculates a round number increment given an approximate increment INCR.}
  542. VAR POWER : LONGINT;      FRACTION : DOUBLE;
  543. BEGIN
  544.   POWER:=TRUNC(LOG(INCR)); FRACTION:=INCR/PWROF10(POWER);
  545.   WHILE FRACTION<1 DO BEGIN
  546.     POWER:=POWER-1; FRACTION:=INCR/PWROF10(POWER);
  547.     END; {WHILE}
  548.   IF FRACTION<2 THEN CALCINCR:=1.0E0 * PWROF10(POWER)
  549.   ELSE IF FRACTION<5 THEN CALCINCR:=2.0E0 * PWROF10(POWER)
  550.   ELSE IF FRACTION<10 THEN CALCINCR:=5.0E0 * PWROF10(POWER)
  551.   ELSE CALCINCR:=10.0E0 * PWROF10(POWER);
  552. END; {FUNCTION CALCINCR}
  553.  
  554. {******************************************************************************}
  555. {* PROCEDURE ENGNOT(NUMBER:DOUBLE; VAR MANTISSA:DOUBLE; VAR EXPONENT:LONGINT) *}
  556. {******************************************************************************}
  557. PROCEDURE ENGNOT;
  558.   {convert number to engineering notation}
  559. BEGIN
  560.   IF NUMBER=0.0 THEN BEGIN
  561.     EXPONENT:=0; MANTISSA:=0.0;
  562.     END
  563.   ELSE BEGIN
  564.     EXPONENT:=TRUNC(LN(ABS(NUMBER))/LN(10));
  565.     IF LN(ABS(NUMBER))/LN(10) <0 THEN EXPONENT:=EXPONENT-1;
  566.     WHILE (EXPONENT MOD 3)<>0 DO EXPONENT:=EXPONENT-1;
  567.     MANTISSA:=NUMBER/PWROF10(EXPONENT);
  568.     END; {ELSE}
  569. END; {PROCEDURE ENGNOT}
  570.  
  571. {*****************************************************************************}
  572. {*************** FUNCTION NUMDEC(NUM:DOUBLE):INTEGER *************************}
  573. {*****************************************************************************}
  574. FUNCTION NUMDEC;
  575.   {calculates the number of decimals in a number - accurate to about 1 part
  576.    in 1E6}
  577. VAR EXTRA : DOUBLE;    DECIMALS : LONGINT;
  578. BEGIN
  579.   DECIMALS:=0;
  580.   EXTRA:=NUM*PWROF10(DECIMALS);
  581.   WHILE (EXTRA-TRUNC(EXTRA+EXTRA*(1E-6))) > (1E-6)*EXTRA DO BEGIN
  582.     DECIMALS:=DECIMALS+1;
  583.     EXTRA:=NUM*PWROF10(DECIMALS);
  584.     END; {WHILE}
  585.   NUMDEC:=DECIMALS;
  586. END; {FUNCTION NUMDEC}
  587.  
  588. {************************************************************************
  589.  TITLE    : EXISTS(FILENAME:STR30):BOOLEAN
  590.  AUTHOR   : Roger Carlson (August 1986)
  591.  FUNCTION : Checks if a file of the specified name already exists on disk.
  592.  INPUTS   : FILENAME - Name of the file.
  593.  OUTPUTS  : EXISTS   - TRUE = file exists.
  594.  NOTES    :
  595.  CHANGES  : (5/30/90,RJC) - Translated to Turbo Pascal.
  596. *************************************************************************}
  597. FUNCTION EXISTS;
  598. VAR TEMP:PATHSTR;
  599. BEGIN
  600.   TEMP:=FSEARCH(FILENAME,'');
  601.   IF TEMP='' THEN EXISTS:=FALSE ELSE EXISTS:=TRUE;
  602. END; {FUNCTION EXISTS}
  603.  
  604. {************************* PROCEDURE BEEP ******************************}
  605. PROCEDURE BEEP;
  606.   {This procedure sounds a short alarm of frequency HZ.}
  607. BEGIN
  608.   SOUND(HZ); DELAY(200); NOSOUND;
  609. END;
  610.  
  611. {************************ FUNCTION INTTOSTR ****************************}
  612. FUNCTION INTTOSTR;
  613. VAR S:STR80;
  614. BEGIN
  615.   STR(I,S); INTTOSTR:=S;
  616. END;
  617.  
  618. {************************ FUNCTION LNGTOSTR *****************************}
  619. FUNCTION LNGTOSTR;
  620. VAR S:STR80;
  621. BEGIN
  622.   STR(I,S); LNGTOSTR:=S;
  623. END;
  624.  
  625. {************************ FUNCTION RLTOSTR ******************************}
  626. FUNCTION RLTOSTR;
  627. VAR S:STR80;
  628. BEGIN
  629.   STR(RL:WIDTH,S); RLTOSTR:=S;
  630. END;
  631.  
  632. END.